home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / schemeMode.tcl < prev    next >
Text File  |  1996-08-15  |  6KB  |  152 lines
  1.  
  2. if {$startingUp} {
  3.     #================================================================================
  4.     addMode Scm dummyScm {*.scm} {}
  5.     return
  6. }
  7.  
  8.  
  9.  
  10. #================================================================================
  11. # Scheme mode definition !  oleg@ponder.csci.unt.edu (Oleg Kiselyov)
  12. #
  13. # $Id: SchemeMode.tcl,v 1.3 1996/07/03 14:19:49 oleg Exp oleg $
  14. #================================================================================
  15. #newModeVar Scm elecRBrace {1} 1
  16. newModeVar Scm leftFillColumn {2} 0
  17. newModeVar Scm prefixString {;; } 0 
  18. #newModeVar Scm electricSemi {1} 1
  19. newModeVar Scm wordBreak {[^\(\) \t\r\n]+} 0
  20. #newModeVar Scm elecLBrace {1} 1
  21. newModeVar Scm wordWrap {0} 1
  22. newModeVar Scm funcExpr {^[\(]define.*$} 0
  23. #newModeVar Scm funcExpr {^[^ \t\(\r/].*\(.*\)$} 0
  24. newModeVar Scm wordBreakPreface {[\(\) \t\r\n]} 0
  25. #newModeVar Scm wordBreakPreface {([^a-zA-Z0-9_])} 0
  26. newModeVar Scm optionIsMeta {1} 1
  27. newModeVar Scm electricTab {1} 1
  28. newModeVar Scm autoMark 0       1
  29.  
  30. set scmCommentRegexp    {;.*$}
  31. set scmPreRegexp                {^\#[\t ]*[a-z]*}
  32. set schemeKeyWords              {
  33.     declare define define-macro lambda let let* letrec begin cond case do else
  34.     delay and or if set! #t #f
  35.     not eqv? eq? equal? pair? cons car cdr set-car! set-cdr!
  36.     caar cadr cdar cddr null? list? list length
  37.     append reverse list-ref memq memv member assq assv assoc
  38.     = < > <= >= zero? positive? negative? odd?
  39.     even? + * - / abs
  40.     exact->inexact inexact->exact number->string
  41.     string->number char? 
  42.     string string-length string-ref string-set! string=?
  43.     substring string-append vector?
  44.     make-vector vector vector-length vector-ref vector-set! procedure?
  45.     apply map for-each call-with-current-continuation
  46.     eof-object? read-char peek-char
  47.         }
  48. #regModeKeywords -e {;} -c cyan -k blue Scm $schemeKeyWords -i ")" -i "("  -i "," -i "." -I red
  49. regModeKeywords -e {;} -c cyan -k blue -s green Scm $schemeKeyWords
  50.  
  51. # meaning that a Tab key does indentation, while Option+Tab or Ctrl+Tab
  52. # do the regular mundane \t
  53. # See indentLine.tcl for more details
  54. bind '\t'       doATab Scm
  55. bind '\t' <o>   {doATab 1} Scm
  56. bind '\t' <z>   {doATab 1} Scm
  57.  
  58. #================================================================================
  59.  
  60. proc dummyScm {} {}
  61.  
  62. proc ScmMarkFile {} {
  63.   set pat1 {^[ \t]*[\(][#a-zA-z]*(define|define-[a-zA-Z]+) +[\(]*([^\(\) \t\r\n]+)}
  64.   set end [maxPos]
  65.   set pos 0
  66.   set l {}
  67.   while {![catch {search -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} {
  68.     regexp -nocase $pat1 [eval getText $mtch] allofit defunname name
  69.     set start [lindex $mtch 0]
  70.     set end [nextLineStart $start]
  71.     set pos $end
  72.     set inds($name) [lineStart [expr $start - 1]]
  73.   }
  74.  
  75.   if {[info exists inds]} {
  76.     foreach f [lsort -ignore [array names inds]] {
  77.       set next [nextLineStart $inds($f)]
  78.       setNamedMark $f $inds($f) $next $next
  79.     }
  80.   }
  81. }
  82.  
  83. #================================================================================
  84. #                                       Indenting a line of a Scheme code
  85. #
  86. # The idea is simple: the indent of a new line is the same as the indent of the
  87. # previous non-empty non-comment-only line *plus* the paren balance of that
  88. # line times two
  89. # That is, if the last code line was paren balanced, the next line would have
  90. # the same indent. If the prev line opened an expression but didn't close it,
  91. # the new line would be indented further
  92. #
  93. # See indentLine.tcl for more details
  94.  
  95. proc ScmindentLine {} {
  96.         set beg [lineStart [getPos]]
  97.         set end [nextLineStart [getPos]]
  98.  
  99.         # Find last previous non-comment line and get its leading whitespace
  100.         set pos $beg
  101.         set lst [search -s -f 0 -r 1 -i 0 {^[ \t]*[^ ;\t\r\n]} [expr $pos-1]]   
  102.         set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  103.         set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  104.  
  105.         # computing the balance of parentheses within the 'line'
  106.         # This appears to be utterly elementary. One has to keep in mind however
  107.         # that parentheses might appear in comments and/or quoted strings,
  108.         # in which case they shouldn't count. Although it's easy to detect a
  109.         # Scheme comment by a semicolon, a semicolon can also appear within
  110.         # a quoted string. Note that a double quote isn't that sure a sign of
  111.         # a quoted string: the double quote may be escaped. And the backslash
  112.         # can be escaped in turn... Thus we face a full-blown problem of parsing
  113.         # a string according to a context-free grammar.
  114.         # We note however that a TCL interpretor does similar kind of parsing
  115.         # all the time. So, we can piggy-back on it and have it decide what is
  116.         # the quoted string and when a semicolon really starts a comment. To this
  117.         # end, we replace all non-essential characters from the 'line' with spaces,
  118.         # separate all parens with spaces (so each paren would register as a
  119.         # separate token with the TCL interpretor), replace a semicolon with
  120.         # an opening brace (which, if unescaped and unquoted, acts as some kind
  121.         # of "comment", that is, shields all symbols that follows).
  122.         # After that, we get TCL interpretor to convert thus prepared 'line'
  123.         # into a list, and simply count the balance of '(' and ')' tokens.
  124.         
  125.         regsub -all -nocase {[^ ();\"\\]} $line { } line1
  126.         regsub -all {;} $line1 "\{" line
  127.         regsub -all {[()]} $line { \0 } line1
  128.         set line_list [eval "list $line1 \}"]
  129.         #alertnote ">$line_list<"
  130.         set balance 0
  131.         foreach i $line_list { switch $i ( {incr balance} ) {incr balance -1} }
  132.         #alertnote "balance $balance, lwhite [string length $lwhite]"
  133.         if {$balance < 0} {
  134.                 set lwhite [string range $lwhite 0 [expr [string length $lwhite] + 2 * $balance - 1]]
  135.         } else {
  136.                 append lwhite [string range "              " 1 [expr 2 * $balance]]
  137.         }
  138.         #alertnote "new lwhite [string length $lwhite]"
  139.                         
  140.         set text [getText $beg [nextLineStart $beg]]
  141.         regexp {^[ \t]*} $text white
  142.         set len [string length $white]
  143.         
  144.         if {$white != $lwhite} {
  145.                 replaceText $beg [expr $beg + $len] $lwhite
  146.         }
  147.         goto [expr $beg + [string length $lwhite]]
  148.         return
  149.         
  150. }
  151.  
  152.